home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
heap_chk.zip
/
HEAP_CHK.PAS
Wrap
Pascal/Delphi Source File
|
1986-05-31
|
2KB
|
63 lines
{ These two routines are for Turbo Pascal Version 3.01A and PC-DOS only and
are simple debugging routines for examining the current heap structure and
the heap free space. To use include this file into your program and call
InitHeap as the first thing in your main program block. This initializes
the heap and prepares for subsequent calls to DumpHeap. Whenever DumpHeap
is then called, it will display a list of used and free memory blocks. This
will help tell if memory is becoming fragmented or pieces of the heap are
being lost. If you have any questions, contact me at
Scott Bussinger
Professional Practice Systems
110 South 131st Street
Tacoma, WA 98444
Compuserve [72247,2671] }
type HeapPointer = ^HeapRec;
HeapRec = record
Next: HeapPointer;
Size: HeapPointer
end;
var HeapStart: HeapPointer;
procedure InitHeap;
{ Initialize the heap display variables }
var HeapWaste: ^byte;
begin
new(HeapStart);
new(HeapWaste);
dispose(HeapStart)
end;
procedure DumpHeap;
{ Display the heap free space chain }
var FreeSpace: real;
Heap: HeapPointer;
function Address(var Pointer): real;
begin
Address := 16.0*seg(Pointer) + ofs(Pointer)
end;
begin
writeln;
writeln('Current Heap Status:');
writeln('--------------------');
FreeSpace := 16.0*memavail-8.0;
if HeapStart^.Next^.Next <> nil then
begin
if Address(HeapStart^.Next^)-Address(HeapStart^)-Address(HeapStart^.Size^)-8.0 <> 0.0 then
writeln(Address(HeapStart^.Next^)-Address(HeapStart^)-Address(HeapStart^.Size^)-8.0:24:0,' bytes used.');
Heap := HeapStart^.Next;
while Heap^.Next <> nil do
begin
writeln(Address(Heap^.Size^):6:0,' bytes free. ',
Address(Heap^.Next^)-Address(Heap^)-Address(Heap^.Size^):5:0,' bytes used.');
FreeSpace := FreeSpace - Address(Heap^.Size^);
Heap := Heap^.Next
end
end;
writeln(FreeSpace:6:0,' bytes free.')
end;